home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
Dev
/
Oberon
/
source
/
FPE
/
FPETpl.mod
< prev
next >
Wrap
Text File
|
1995-06-29
|
9KB
|
379 lines
(***************************************************************************
$RCSfile: FPETpl.mod $
Description: Defines and implements the IntuiSup template for the main
FPE window.
Created by: fjc (Frank Copeland)
$Revision: 1.10 $
$Author: fjc $
$Date: 1995/06/04 22:44:18 $
Copyright © 1993-1994, Frank Copeland.
This file is part of FPE.
See FPE.doc for conditions of use and distribution.
Log entries are at the end of the file.
***************************************************************************)
<* MAIN- *> <*$ NilChk- *>
MODULE FPETpl;
IMPORT
SYS := SYSTEM, Kernel, e := Exec, i := Intuition, is := IntuiSup, Data;
(*------------------------------------*)
(* Project Information *)
CONST
LeftEdge * = 0;
TopEdge * = 0;
Width * = 438;
VAR
Height * : INTEGER;
CONST
RenderInfoFlags * = {};
OpenWindowFlags * = {is.owCenterScreen};
WindowFlags * =
i.smartRefresh +
(*i.simpleRefresh +*)
{ i.windowDrag .. i.windowClose, i.activate, i.noCareRefresh };
GadgetIDCMPFlags * = is.giButton + is.giCheck + is.giListview;
(*------------------------------------*)
(* Gadget data *)
CONST
NumGadgetDatas * = 17;
TYPE
GadgetDataPtr * = POINTER TO GadgetData;
GadgetData * = RECORD
g0 * : is.ListViewData;
g1 * : ARRAY Data.NumFiles OF is.CheckData;
g2 * : ARRAY Data.NumTools OF is.ButtonData;
dataEnd : LONGINT;
END; (* GadgetData *)
(*------------------------------------*)
(* Text data *)
CONST
NumTextDatas * = 10;
(*------------------------------------*)
(* Border data *)
CONST
NumBorderDatas * = 1;
(*------------------------------------*)
(* Template data structure *)
TYPE
Template * = RECORD
GadgetData * : GadgetDataPtr;
TextData * : is.TextDataListPtr;
BorderData * : is.BorderDataListPtr;
END; (* Template *)
(*------------------------------------*)
PROCEDURE TextHeight () : INTEGER;
VAR scr : i.Screen;
BEGIN (* TextHeight *)
IF i.GetScreenData (scr, SIZE (i.Screen), {i.wbenchScreen}, NIL) THEN
RETURN scr.font.ySize
ELSE
RETURN 9
END
END TextHeight;
(*------------------------------------*)
(* Gadget data *)
(*------------------------------------*)
PROCEDURE InitGadgetData (gd : GadgetDataPtr);
VAR textHeight : INTEGER;
BEGIN (* InitGadgetData *)
ASSERT (gd # NIL, 97);
textHeight := TextHeight();
gd.g0.type := is.listView;
gd.g0.flags := {is.gdListviewShowSelected};
gd.g0.leftEdge := 13;
gd.g0.topEdge := (3 * textHeight) + 19;
gd.g0.width := 169;
gd.g0.height := (5 * textHeight) + 4;
gd.g1[0].type := is.check;
gd.g1[0].flags := {is.gdTextRight};
gd.g1[0].leftEdge := 13;
gd.g1[0].topEdge := (9 * textHeight) + 32;
gd.g1[0].width := 27;
gd.g1[0].height := textHeight + 3;
gd.g1[1].type := is.check;
gd.g1[1].flags := {is.gdTextRight};
gd.g1[1].leftEdge := 100;
gd.g1[1].topEdge := (9 * textHeight) + 32;
gd.g1[1].width := 27;
gd.g1[1].height := textHeight + 3;
gd.g1[2].type := is.check;
gd.g1[2].flags := {is.gdTextRight};
gd.g1[2].leftEdge := 13;
gd.g1[2].topEdge := (10 * textHeight) + 40;
gd.g1[2].width := 27;
gd.g1[2].height := textHeight + 3;
gd.g1[3].type := is.check;
gd.g1[3].flags := {is.gdTextRight};
gd.g1[3].leftEdge := 100;
gd.g1[3].topEdge := (10 * textHeight) + 40;
gd.g1[3].width := 27;
gd.g1[3].height := textHeight + 3;
gd.g2[0].type := is.button;
gd.g2[0].leftEdge := 189;
gd.g2[0].topEdge := (3 * textHeight) + 19;
gd.g2[0].width := 113;
gd.g2[0].height := textHeight + 6;
gd.g2[1].type := is.button;
gd.g2[1].leftEdge := 312;
gd.g2[1].topEdge := (3 * textHeight) + 19;
gd.g2[1].width := 113;
gd.g2[1].height := textHeight + 6;
gd.g2[2].type := is.button;
gd.g2[2].leftEdge := 189;
gd.g2[2].topEdge := (4 * textHeight) + 26;
gd.g2[2].width := 113;
gd.g2[2].height := textHeight + 6;
gd.g2[3].type := is.button;
gd.g2[3].leftEdge := 312;
gd.g2[3].topEdge := (4 * textHeight) + 26;
gd.g2[3].width := 113;
gd.g2[3].height := textHeight + 6;
gd.g2[4].type := is.button;
gd.g2[4].leftEdge := 189;
gd.g2[4].topEdge := (5 * textHeight) + 33;
gd.g2[4].width := 113;
gd.g2[4].height := textHeight + 6;
gd.g2[5].type := is.button;
gd.g2[5].leftEdge := 312;
gd.g2[5].topEdge := (5 * textHeight) + 33;
gd.g2[5].width := 113;
gd.g2[5].height := textHeight + 6;
gd.g2[6].type := is.button;
gd.g2[6].leftEdge := 189;
gd.g2[6].topEdge := (6 * textHeight) + 40;
gd.g2[6].width := 113;
gd.g2[6].height := textHeight + 6;
gd.g2[7].type := is.button;
gd.g2[7].leftEdge := 312;
gd.g2[7].topEdge := (6 * textHeight) + 40;
gd.g2[7].width := 113;
gd.g2[7].height := textHeight + 6;
gd.g2[8].type := is.button;
gd.g2[8].leftEdge := 189;
gd.g2[8].topEdge := (7 * textHeight) + 47;
gd.g2[8].width := 113;
gd.g2[8].height := textHeight + 6;
gd.g2[9].type := is.button;
gd.g2[9].leftEdge := 312;
gd.g2[9].topEdge := (7 * textHeight) + 47;
gd.g2[9].width := 113;
gd.g2[9].height := textHeight + 6;
gd.g2[10].type := is.button;
gd.g2[10].leftEdge := 189;
gd.g2[10].topEdge := (8 * textHeight) + 54;
gd.g2[10].width := 113;
gd.g2[10].height := textHeight + 6;
gd.g2[11].type := is.button;
gd.g2[11].leftEdge := 312;
gd.g2[11].topEdge := (8 * textHeight) + 54;
gd.g2[11].width := 113;
gd.g2[11].height := textHeight + 6;
gd.dataEnd := is.dataEnd;
END InitGadgetData;
(*------------------------------------*)
(* Text data *)
(*------------------------------------*)
PROCEDURE InitTextData (td : is.TextDataListPtr);
VAR textHeight : INTEGER;
<*$ < IndexChk- *>
BEGIN (* InitTextData *)
ASSERT (td # NIL, 97);
textHeight := TextHeight();
td[0].type := is.text;
td[0].leftEdge := 15;
td[0].topEdge := textHeight + 10;
td[0].text := SYS.ADR("Project");
td[1].type := is.text;
td[1].flags := {is.tdBackFill};
td[1].leftEdge := 95;
td[1].topEdge := textHeight + 9;
td[2].type := is.text;
td[2].leftEdge := 65;
td[2].topEdge := (2 * textHeight) + 16;
td[2].text := SYS.ADR("Modules");
td[3].type := is.text;
td[3].leftEdge := 281;
td[3].topEdge := (2 * textHeight) + 16;
td[3].text := SYS.ADR("Tools");
td[4].type := is.text;
td[4].leftEdge := 73;
td[4].topEdge := (8 * textHeight) + 29;
td[4].text := SYS.ADR("Files");
td[5].type := is.text;
td[5].flags := {is.tdColor2};
td[5].leftEdge := 13;
td[5].topEdge := textHeight + 9;
td[5].text := SYS.ADR("Project");
td[6].type := is.text;
td[6].flags := {is.tdColor2};
td[6].leftEdge := 63;
td[6].topEdge := (2 * textHeight) + 15;
td[6].text := SYS.ADR("Modules");
td[7].type := is.text;
td[7].flags := {is.tdColor2};
td[7].leftEdge := 279;
td[7].topEdge := (2 * textHeight) + 15;
td[7].text := SYS.ADR("Tools");
td[8].type := is.text;
td[8].flags := {is.tdColor2};
td[8].leftEdge := 71;
td[8].topEdge := (8 * textHeight) + 28;
td[8].text := SYS.ADR("Files");
td[9].type := is.dataEnd;
END InitTextData;
(*$ > *)
(*------------------------------------*)
(* Border data *)
(*------------------------------------*)
PROCEDURE InitBorderData (bd : is.BorderDataListPtr);
VAR textHeight : INTEGER;
<*$ < IndexChk- *>
BEGIN (* InitBorderData *)
ASSERT (bd # NIL, 97);
textHeight := TextHeight();
bd[0].type := is.box1In;
bd[0].leftEdge := 90;
bd[0].topEdge := textHeight + 7;
bd[0].width := 334;
bd[0].height := textHeight + 4;
bd[1].type := is.dataEnd;
END InitBorderData;
(*$ > *)
(*------------------------------------*)
PROCEDURE Init * (VAR template : Template);
BEGIN (* Init *)
Height := (11 * TextHeight()) + 50;
NEW (template.GadgetData);
InitGadgetData (template.GadgetData);
Kernel.Allocate
( template.TextData,
SIZE (is.TextData) * NumTextDatas + 4,
{e.memClear} );
InitTextData (template.TextData);
Kernel.Allocate
( template.BorderData,
SIZE (is.BorderData) * NumBorderDatas + 4,
{e.memClear} );
InitBorderData (template.BorderData)
END Init;
(*------------------------------------*)
PROCEDURE Cleanup * (VAR template : Template);
BEGIN (* Cleanup *)
SYS.DISPOSE (template.GadgetData);
SYS.DISPOSE (template.TextData);
SYS.DISPOSE (template.BorderData);
END Cleanup;
END FPETpl.
(***************************************************************************
$Log: FPETpl.mod $
Revision 1.10 1995/06/04 22:44:18 fjc
- Changed text colours.
Revision 1.9 1995/01/26 00:15:33 fjc
- Release 1.5
Revision 1.8 1994/09/25 18:20:54 fjc
- Uses new syntax for external code declarations
Revision 1.7 1994/08/08 16:14:33 fjc
Release 1.4
Revision 1.6 1994/06/17 17:26:27 fjc
- Updated for release
Revision 1.5 1994/06/09 13:38:52 fjc
- Incorporated changes in Amiga interface.
Revision 1.4 1994/06/04 23:49:52 fjc
- Changed to use new Amiga interface
Revision 1.3 1994/05/12 21:26:09 fjc
- Prepared for release
Revision 1.2 1994/01/24 14:33:33 fjc
Changed version control header
Revision 1.1 1994/01/15 17:32:38 fjc
Start of revision control
***************************************************************************)